home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / prog / langwn23.zip / SAMPLE01.BAS < prev    next >
BASIC Source File  |  1993-03-20  |  38KB  |  1,240 lines
  1. '============================================================================
  2. '============================================================================
  3.  
  4. ' sample code 01 to demonstrate techniques for using LangWin.
  5.  
  6. ' hit Shift+F5 to run this code.
  7. ' follow instructions displayed in each sample window.
  8.  
  9. ' you must start QuickBASIC as follows:  qb /ah /L langwin
  10. '    /L langwin parameter provides access to LangWin quicklib
  11. '    /ah parameter is needed to allow dynamic arrays > 64k.
  12.  
  13. ' hit F2, then select one of the demo subroutines to examine sample code
  14.  
  15. ' subroutines called to display sample windows
  16. DECLARE SUB demo1 ()
  17. DECLARE SUB demo2 ()
  18. DECLARE SUB demo3 ()
  19. DECLARE SUB demo4 ()
  20. DECLARE SUB demo5 ()
  21. DECLARE SUB demo6 ()
  22.  
  23. DECLARE FUNCTION VidType% ()  ' used to determine type of monitor
  24.  
  25. '  must compile with qb /ah /L langwin
  26.  
  27. '$DYNAMIC  make all arrays dynamic
  28.  
  29. DEFINT A-Z
  30.  
  31. '$INCLUDE: 'LANGWIN.BI' ' TYPE, DECLARE and COMMON definitions for LangWin.
  32. '                         NOTE: LANGWIN.BI contains all definitions found
  33. '                               in QB.BI, so include for QB.BI is not needed.
  34.  
  35.  
  36.  
  37. CLEAR , , 5000   ' set stack at 5000 bytes
  38.  
  39.  
  40. '---------------------------------------------------------------
  41. ' first see if EGA or VGA monitor
  42. mm = VidType
  43. IF mm <> 3 AND mm <> 4 THEN
  44.     ' monitor is not EGA/VGA
  45.     ' take whatever actions necessary (error messages)
  46.     BEEP
  47.     PRINT "LangWin needs EGA or VGA, sorry ........"
  48.     END
  49. END IF
  50.  
  51.  
  52. '-----------------------------------------------------------------
  53. ' get attribute from current screen (row 1, col 1)
  54. ' so it can be restored upon exit
  55. OrigAttr = SCREEN(1, 1, 1)
  56.  
  57. '-------------------------------------------------------------------
  58. ' if WIDTH command is used, it must be placed before call to LangWinInit
  59. ' because code in LangWinInit extracts max rows/cols from screen and saves
  60. ' in global variables. if WIDTH is used after LangWinInit, the global
  61. ' variable will not be set correctly.
  62. WIDTH 80, 25
  63.  
  64. '----------------------------------------------------------------------
  65. ' these variables MUST be defined BEFORE call to LangWinInit.
  66. ' keep these as low as possible to conserve memory at run time.
  67. MaxWindows = 8       ' max simultaneous open windows
  68. MaxButtons = 30      ' max number of objects (incl lines with labels) active
  69. MaxTextLines = 35    ' maximum number of text lines in any scrollable win
  70. MaxTextWins = 5      ' max windows that can have scrollable text
  71.                      ' must be <= MaxWindows
  72.  
  73. LOCATE , , 0         ' start with hidden text cursor
  74.  
  75. '---------------------------------------------------------------------------
  76. ' LangWin only supports text mode. You MUST call the SCREEN 0 command BEFORE
  77. ' the call to LangWinInit. You can call SCREEN with a video page other than 0
  78. ' (i.e., SCREEN 0,,x,x   where x is a page number supported by your system).
  79. ' Code in LangWinInit will determine which video page you are using and save
  80. ' the value in a global variable for use by other LangWin routines. If you
  81. ' call SCREEN 0 after LangWinInit and change the original video page, you'll
  82. ' get unpredictable results (i.e., LangWin will write to the original video
  83. ' page). However, you can use other video pages for functions not associated
  84. ' with your LangWin windows; just be sure to set the video page back to the
  85. ' original value defined below.
  86.  
  87. SCREEN 0, , 0, 0        ' LangWin ONLY supports text mode
  88.                         ' You MUST call the SCREEN command BEFORE LangWinInit
  89.  
  90.  
  91. CALL LangWinInit     ' initialize (if mouse exists, it will be displayed)
  92.               
  93.                      ' if you get "subscript out of range" error while
  94.                      ' in this routine, be sure you called QB with /ah.
  95.                      ' then try reducing the value of MaxWindows.
  96.                      ' check the WIDTH command; reduce number of columns,
  97.                      ' and/or number of rows.
  98.  
  99. '-----------------------------------------------------------------------
  100. ' display "wallpaper"
  101.  
  102. IF HaveMouse THEN CALL HideMouseCursor  ' first hide mouse pointer
  103.  
  104. CLS
  105. CALL SetColor(8, 15)
  106. FOR i = 1 TO MaxRows
  107. LOCATE i, 1
  108. PRINT STRING$(80, 178);     ' can try 176, 177, or 178
  109. NEXT
  110.  
  111. IF HaveMouse THEN CALL ShowMouseCursor   ' display the mouse pointer
  112.  
  113. '====================================================================
  114.  
  115. CALL demo1    ' simple window
  116. CALL demo2    ' add window with buttons
  117. CALL demo3    ' add button that causes child window(s) to be opened
  118. CALL demo4    ' window with input fields & child window
  119. CALL demo5    ' scrollable text windows & child windows
  120. CALL demo6    ' password entry technique
  121.  
  122. '=====================================================================
  123.  
  124.  
  125. IF HaveMouse THEN HideMouseCursor    ' we're done with the mouse
  126.  
  127. bbb = (OrigAttr AND &HF0) \ 16  ' mask & shift to get original background
  128. fff = OrigAttr AND &HF          ' mask to get original foreground
  129.  
  130.  
  131. PALETTE                           ' restore original palette
  132. CALL SetColor(fff, bbb)           ' restore orig foreground/background
  133. CLS
  134. LOCATE , , 1                      ' make text cursor visible
  135.  
  136. END
  137.  
  138. REM $STATIC
  139. '
  140. '  one window opened; it contains info text only.
  141. '  no scrollable text, no buttons.
  142. '  only valid event is 'close'
  143. '  (window can be moved).
  144. '
  145. SUB demo1
  146.  
  147. '=================================================
  148. ' first window: info text only  (w1 contains window's number or error code)
  149. w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1)
  150.  
  151. ' test to see if window was successfully opened
  152. IF w1 < 0 THEN
  153. '  some code to handle the error
  154.     CLS
  155.     PRINT "w1 BlankWin error number: "; w1
  156.     END
  157. END IF
  158.  
  159. ' display some text in the window
  160. d = ShowWinText(2, 2, 0, "Close window to exit")
  161. d = ShowWinText(3, 2, 0, "(double click top/left).")
  162. d = ShowWinText(5, 2, 0, "Drag top/left corner to move.")
  163. ' put a title in window
  164. d = ShowTitle("Info Only Window", 15, 1)
  165. ' no error tests will be made for above functions
  166.  
  167.  
  168. '=============================================================
  169.  
  170.  
  171. ' MAIN LOOP
  172. ' as long as any win is open
  173. ' wait for an event in any window, then process it
  174.  
  175. DO WHILE AnyWinOpen
  176.     ' wait for an event
  177.     ' win number (wn) and event code (action) returned
  178.     wn = WinEvent(action)
  179.  
  180.     ' test window number to see which window was current when event occurred
  181.     SELECT CASE wn
  182.  
  183.     CASE w1      ' first window
  184.         ' now determine what type of event occurred in the window w1
  185.         SELECT CASE action
  186.         CASE 1      ' close
  187.             xx = CloseWindow
  188.         CASE 2      ' text
  189.             ' no scrollable text to select in this win
  190.             ' this case could be omitted
  191.         CASE 3      ' button
  192.             ' no buttons in this win
  193.             ' this case could be omitted
  194.         END SELECT
  195.  
  196.     END SELECT
  197.  
  198.  
  199. LOOP
  200.  
  201. LOCATE 25, 1
  202. CALL SetColor(15, 4)
  203. PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
  204. SLEEP
  205.  
  206. LOCATE 25, 1
  207. CALL SetColor(8, 15)
  208. PRINT STRING$(80, 178);
  209.  
  210. END SUB
  211.  
  212. '
  213. '  this demo adds to the code developed for demo1
  214. '
  215. '  two windows opened:
  216. '  the first has info text only.
  217. '  the second has two buttons:
  218. '  1) beep; 2) exit
  219. '
  220. SUB demo2
  221.  
  222. '=================================================
  223. ' first window: info text only  (w1 contains window's number or error code)
  224. w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1)
  225.  
  226. ' test to see if window was successfully opened
  227. IF w1 < 0 THEN
  228. '  some code to handle the error
  229.     CLS
  230.     PRINT "w1 BlankWin error number: "; w1
  231.     END
  232. END IF
  233.  
  234. ' display some text in the window
  235. d = ShowWinText(2, 2, 0, "Close window to exit")
  236. d = ShowWinText(3, 2, 0, "(double click top/left).")
  237. d = ShowWinText(5, 2, 0, "Drag top/left corner to move.")
  238. ' put a title in window
  239. d = ShowTitle("Info Only Window", 15, 1)
  240. ' no error tests will be made for above functions
  241.  
  242.  
  243. '=============================================================
  244. ' second window: text and buttons (w2 contains window's number or error code)
  245. w2 = BlankWin(9, 26, 21, 66, 9, 15, 1, 0, 0, 1)
  246.  
  247. ' test to see if window was successfully opened
  248. IF w2 < 0 THEN
  249. '  some code to handle the error
  250.     CLS
  251.     PRINT "w2 BlankWin error number: "; w2
  252.     END
  253. END IF
  254.  
  255. ' display some text in the window
  256. d = ShowWinText(1, 2, 15, "Click button to exit.")
  257. d = ShowWinText(2, 2, 15, "Drag top/left to move.")
  258. ' put a title in window
  259. d = ShowTitle("Window With Buttons", 15, 6)
  260. ' no error tests will done for above functions
  261.  
  262. ' make buttons.
  263. ' save handle numbers in variables.
  264. ' these will be used later to determine which button was clicked.
  265. beep2 = MakePushButton(7, 10, 6, "BEEP", 15, 3, 1)
  266. xit2 = MakePushButton(10, 10, 6, "EXIT", 15, 4, 1)
  267.  
  268. ' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
  269. WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure
  270. CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus
  271.  
  272. '=============================================================
  273.  
  274.  
  275. ' MAIN LOOP
  276. ' as long as any win is open
  277. ' wait for an event in any window, then process it
  278.  
  279. DO WHILE AnyWinOpen
  280.     ' wait for an event
  281.     ' win number (wn) and event code (action) returned
  282.     wn = WinEvent(action)
  283.  
  284.     ' test window number to see which window was current when event occurred
  285.     SELECT CASE wn
  286.  
  287.     CASE w1      ' first window
  288.         ' now determine what type of event occurred in the window w1
  289.         SELECT CASE action
  290.         CASE 1      ' close
  291.             xx = CloseWindow
  292.         CASE 2      ' text
  293.             ' no scrollable text to select in this win
  294.         CASE 3      ' button
  295.             ' no buttons in this win
  296.         END SELECT
  297.  
  298.     CASE w2      ' second window
  299.         ' now determine what type of event occurred in the window w2
  300.         SELECT CASE action
  301.         CASE 1      ' close
  302.             ' even though window has no close icon,
  303.             ' ESC will generate a close event.
  304.             ' we will ignore the close event
  305.             ' since win has specific EXIT button.
  306.         CASE 2      ' text
  307.             ' no scrollable text to select in this win
  308.         CASE 3      ' button
  309.             ' determine which button was clicked
  310.   
  311.             ' get handle number of clicked button
  312.             ButtonHandle = WinParms(CurWinPtr, 16)
  313.  
  314.             ' test all buttons for match
  315.             SELECT CASE ButtonHandle
  316.             CASE xit2   ' exit
  317.                 xx = CloseWindow
  318.             CASE beep2  ' beep
  319.                 BEEP
  320.             END SELECT
  321.         END SELECT
  322.  
  323.     END SELECT
  324.  
  325.  
  326. LOOP
  327.  
  328. LOCATE 25, 1
  329. CALL SetColor(15, 4)
  330. PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
  331. SLEEP
  332.  
  333. LOCATE 25, 1
  334. CALL SetColor(8, 15)
  335. PRINT STRING$(80, 178);
  336.  
  337. END SUB
  338.  
  339. '
  340. '  this demo adds to the code developed for demos 1 & 2.
  341. '
  342. '  two windows opened:
  343. '  the first has info text only.
  344. '  the second has three buttons:
  345. '  1) beep; 2) exit; 3) open a new child (subordinate) window
  346. '  4) sample error window
  347. '
  348. '  only one child window can be open at a time.
  349. '  once the third button is clicked and a child window
  350. '  is open, the button is de-activated and cleared.
  351. '  after the user closes the child window, the button will be re-activated.
  352. '
  353. '  similarly, the second button (exit) cannot be selected while a child
  354. '  window is open.
  355. '
  356. '  in theory, if you have an event (ie button or text) that causes another
  357. '  window to be open, the user of your program could continue to click the
  358. '  button (or text) opening windows until the MaxWindows limit is reached.
  359. '  each window that is open will be given a unique window number.
  360. '  since the WinEvent loop must account for every open window number,
  361. '  this could result in long and complex code
  362. '  (although the same code segments could be used to handle
  363. '  events for different window numbers). in any case, this demo
  364. '  shows code that can be used to restrict the number of child
  365. '  windows that can be opened dynamically (ie by user selecting a button
  366. '  or text event at run time).
  367. '
  368. '  this code also shows examples of how one can prevent a parent window
  369. '  from being closed while child (subordinate) windows are still open.
  370. '
  371. '  if the fourth button is clicked, a modal error window is opened
  372. '  (a modal window is one that will retain focus, regardless of
  373. '  any events/clicks, until it is closed). in the example, the error
  374. '  window contains some error text, and
  375. '  requires the user to click an "OK" button before any
  376. '  more processing will be done. if the user clicks on any other
  377. '  window or button, it will be ignored
  378. '  until the "OK" button in the error window is clicked.
  379. '  in practice, the modal error window could result
  380. '  from an invalid button click (not allowed at that point),
  381. '  or an erroneous entry/selection by the user.
  382. '
  383. SUB demo3
  384.  
  385.  
  386. '=================================================
  387. ' first window: info text only  (w1 contains window's number or error code)
  388. w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1)
  389.  
  390. ' test to see if window was successfully opened
  391. IF w1 < 0 THEN
  392. '  some code to handle the error
  393.     CLS
  394.     PRINT "w1 BlankWin error number: "; w1
  395.     END
  396. END IF
  397.  
  398. ' display some text in the window
  399. d = ShowWinText(2, 2, 0, "Close window to exit")
  400. d = ShowWinText(3, 2, 0, "(double click top/left).")
  401. d = ShowWinText(5, 2, 0, "Drag top/left corner to move.")
  402. ' put a title in window
  403. d = ShowTitle("Info Only Window", 15, 1)
  404. ' no error tests will be made for above functions
  405.  
  406.  
  407. '=============================================================
  408. ' second window: text and buttons (w2 contains window's number or error code)
  409. w2 = BlankWin(9, 26, 21, 66, 9, 15, 1, 0, 0, 1)
  410.  
  411. ' test to see if window was successfully opened
  412. IF w2 < 0 THEN
  413. '  some code to handle the error
  414.     CLS
  415.     PRINT "w2 BlankWin error number: "; w2
  416.     END
  417. END IF
  418.  
  419. ' display some text in the window
  420. d = ShowWinText(1, 2, 15, "Click button to exit.")
  421. d = ShowWinText(2, 2, 15, "Drag top/left to move.")
  422. d = ShowWinText(3, 2, 15, "Click button to open new win")
  423. d = ShowWinText(4, 2, 15, "Click button to open error win")
  424. ' put a title in window
  425. d = ShowTitle("Window With Buttons", 15, 6)
  426. ' no error tests will done for above functions
  427.  
  428. ' make buttons.
  429. ' save handle numbers in variables.
  430. ' these will be used later to determine which button was clicked.
  431. beep2 = MakePushButton(7, 10, 6, "BEEP", 15, 3, 1)
  432. xit2 = MakePushButton(10, 10, 6, "EXIT", 15, 4, 1)
  433. new2 = MakePushButton(10, 20, 9, "New Win", 15, 2, 1)
  434. errorb = MakePushButton(7, 20, 7, "ERROR", 15, 5, 1)
  435.  
  436. ' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
  437. WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure
  438. CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus
  439.  
  440. '=============================================================
  441.  
  442.  
  443. ' MAIN LOOP
  444. ' as long as any win is open
  445. ' wait for an event in any window, then process it
  446.  
  447. DO WHILE AnyWinOpen
  448.     ' wait for an event
  449.     ' win number (wn) and event code (action) returned
  450.     wn = WinEvent(action)
  451.  
  452.     ' test window number to see which window was current when event occurred
  453.     SELECT CASE wn
  454.  
  455.     CASE w1      ' first window
  456.         ' now determine what type of event occurred in the window w1
  457.         SELECT CASE action
  458.         CASE 1      ' close
  459.             xx = CloseWindow
  460.         CASE 2      ' text
  461.             ' no scrollable text to select in this win
  462.         CASE 3      ' button
  463.             ' no buttons in this win
  464.         END SELECT
  465.  
  466.     CASE w2      ' second window
  467.         ' now determine what type of event occurred in the window w2
  468.         SELECT CASE action
  469.         CASE 1      ' close
  470.             ' even though window has no close icon,
  471.             ' ESC will generate a close event.
  472.             ' i'll choose to ignore the close event
  473.             ' since this win has specific EXIT button.
  474.             ' so, there will be no call to CloseWindow here
  475.         CASE 2      ' text
  476.             ' no scrollable text to select in this win
  477.         CASE 3      ' button
  478.             ' determine which button was clicked
  479.    
  480.             ' get handle number of clicked button
  481.             ButtonHandle = WinParms(CurWinPtr, 16)
  482.  
  483.             ' test all buttons for match
  484.             SELECT CASE ButtonHandle
  485.             CASE xit2   ' exit
  486.                 xx = CloseWindow
  487.             CASE beep2  ' beep
  488.                 BEEP
  489.             CASE new2   ' open a new child window
  490.                
  491.                 ' first deactivate (clear) the "new win" & "exit" buttons.
  492.                 ' this code should be placed before child window is opened
  493.                 ' to insure that window with buttons is active
  494.                 ' (thus the FocusSw parm can be 0)
  495.                 d = DeactivateButton(new2, 0)
  496.                 d = DeactivateButton(xit2, 0)
  497.  
  498.  
  499.                 ' open a child window
  500.                 w3a = BlankWin(3, 46, 10, 74, 6, 15, 1, 0, 1, 1)
  501.                 ' test to see if window was successfully opened
  502.                 IF w3a < 0 THEN
  503.                 '  some code to handle the error
  504.                     CLS
  505.                     PRINT "w3a BlankWin error number: "; w3a
  506.                     END
  507.                 END IF
  508.                 ' put some text into the window
  509.                 d = ShowWinText(1, 2, 15, "Child WIndow")
  510.  
  511.             CASE errorb  ' error button
  512.                 ' open a modal error window
  513.                 ' that is, no other window is processed until
  514.                 ' this modal window is closed
  515.                 erwin = BlankWin(10, 6, 19, 36, 5, 15, 1, 0, 0, 2)
  516.                 ' test to see if window was successfully opened
  517.                 IF erwin < 0 THEN
  518.                 '  some code to handle the error
  519.                     CLS
  520.                     PRINT "erwin BlankWin error number: "; erwin
  521.                     END
  522.                 END IF
  523.                 ' put some text into the window
  524.                 d = ShowWinText(2, 3, 14, "Sample Error Window")
  525.                 d = ShowWinText(4, 3, 15, "All events ignored until")
  526.                 d = ShowWinText(5, 3, 15, "you click OK to continue")
  527.                 ok3 = MakePushButton(7, 10, 4, "OK", 15, 3, 1)
  528.                 
  529.            
  530.             END SELECT ' end of select for button in window w2
  531.         END SELECT  ' end of select for window w2
  532.  
  533.     CASE w3a
  534.         ' determine what type of event occurred in the window w3a
  535.         SELECT CASE action
  536.         CASE 1      ' close
  537.             xx = CloseWindow   ' close the window
  538.            
  539.             ' re-activate new-win and exit buttons
  540.             ' and leave focus in window containing the buttons
  541.             d = ActivateButton(new2, 0)
  542.             d = ActivateButton(xit2, 0)
  543.  
  544.        
  545.         CASE 2      ' text
  546.             ' no scrollable text to select in this win
  547.         CASE 3      ' button
  548.             ' no buttons in this win
  549.        
  550.         END SELECT
  551.  
  552.     CASE erwin   ' the error window
  553.         ' only valid action in this window a button click,
  554.         ' and only valid button is the ok button to close
  555.         ' so i'll just close the window if anything happens.
  556.         xx = CloseWindow
  557.  
  558.     END SELECT
  559.  
  560.  
  561. LOOP
  562.  
  563. LOCATE 25, 1
  564. CALL SetColor(15, 4)
  565. PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
  566. SLEEP
  567.  
  568. LOCATE 25, 1
  569. CALL SetColor(8, 15)
  570. PRINT STRING$(80, 178);
  571.  
  572. END SUB
  573.  
  574. '
  575. '
  576. ' open a plain window with input fields and two buttons: EXIT & SHOW.
  577. '
  578. ' user updates input field and clicks on "SHOW" button to display fields
  579. ' in a new window. while this child window is open,
  580. ' neither the SHOW or EXIT buttons are active (in addition, the
  581. ' contents of these buttons are cleared to remind user they are
  582. ' not active).
  583. '
  584. ' when sub window is closed, the EXIT and SHOW buttons are again displayed
  585. ' and will be active.
  586. '
  587. SUB demo4
  588.  
  589.  
  590. ' open a plain window (no scrollable text, close icon)
  591. w1 = BlankWin(3, 3, 21, 60, 9, 15, 2, 0, 1, 1)
  592.  
  593. ' test to see if window was successfully opened
  594. IF w1 < 0 THEN
  595.     '  some code to handle the error
  596.     CLS
  597.     PRINT "w1 BlankWin error: "; w1
  598.     END
  599. END IF
  600.  
  601.  
  602.  
  603. ' display some text in the window
  604. d = ShowWinText(2, 2, 15, "Name:")
  605. d = ShowWinText(4, 2, 15, "Address:")
  606. d = ShowWinText(6, 2, 15, "City:")
  607. d = ShowWinText(8, 2, 15, "State:")
  608. d = ShowWinText(10, 2, 15, "Zip Code:")
  609.  
  610. d = ShowWinText(12, 5, 14, "Enter data, then click on SHOW.")
  611. d = ShowWinText(13, 2, 14, "(CANNOT close this window if SHOW window is open.)")
  612. d = ShowWinText(14, 2, 14, "(CANNOT click on SHOW if SHOW window is already open.)")
  613.  
  614.  
  615. ' make input fields
  616. ' save the handles in variables.
  617. ' these will be used later to extract contents of input fields.
  618. nam = MakeInputField(2, 12, 25, "", 14, 1)
  619. addr = MakeInputField(4, 12, 25, "", 14, 1)
  620. city = MakeInputField(6, 12, 25, "", 14, 1)
  621. state = MakeInputField(8, 12, 25, "", 14, 1)
  622. zip = MakeInputField(10, 12, 25, "", 14, 1)
  623.  
  624.  
  625. ' make buttons.
  626. ' save handle numbers in variables.
  627. ' these will be used later to determine which button was clicked.
  628. sho = MakePushButton(16, 20, 6, "SHOW", 15, 4, 1)
  629. xit = MakePushButton(16, 10, 6, "EXIT", 15, 4, 1)
  630.  
  631. ' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
  632. WinParms(CurWinPtr, 16) = xit' put handle of exit button into data structure
  633. CALL ChangeButtonFocus(xit, 0) ' reverse video the button to give it focus
  634.  
  635.  
  636. ' put a title in window
  637. d = ShowTitle("Window With Input Fields", 15, 4)
  638.  
  639. ' MAIN LOOP
  640. ' as long as any win is open
  641. ' wait for an event in any window, then process it
  642.  
  643. DO WHILE AnyWinOpen
  644.     ' wait for an event
  645.     ' win number (wn) and event code (action) returned
  646.     wn = WinEvent(action)
  647.  
  648.     ' test window number to see which window was current when event occurred
  649.     SELECT CASE wn
  650.  
  651.     CASE w1    ' main window
  652.         ' now determine what type of event occurred in the window w1
  653.         SELECT CASE action
  654.         CASE 1      ' close
  655.  
  656.             ' before we can close main window (w1),
  657.             ' make sure child window (w2) is not open.
  658.             IF NOT IsWinOpen(w2, wh) THEN xx = CloseWindow
  659.  
  660.         CASE 2  ' scrollable text
  661.             ' there is no scrollable text, ignore this event
  662.  
  663.         CASE 3   ' button click
  664.  
  665.             ' lets see which button was clicked (if we had more than 1 button)
  666.      
  667.             ' get handle number of clicked button
  668.             ButtonHandle = WinParms(CurWinPtr, 16)
  669.  
  670.             ' test all buttons for match
  671.             SELECT CASE ButtonHandle
  672.             CASE xit   ' exit
  673.                 xx = CloseWindow
  674.  
  675.             CASE sho    ' show button
  676.   
  677.                   ' first, clear the show and exit buttons to
  678.                   ' deactivate them.
  679.                   ' this code should be placed before child window is opened
  680.                   ' to insure that window with buttons is active
  681.                   ' (thus the FocusSw parm can be 0)
  682.                   d = DeactivateButton(sho, 0)
  683.                   d = DeactivateButton(xit, 0)
  684.                  
  685.                   ' open a child window and display all input fields
  686.                   ' contents of all fields are in ButtonsText(handle).
  687.                   ' just use handle of each input field
  688.                   ' (returned by MakeInputField) to extract field contents.
  689.           
  690.                   w2 = BlankWin(5, 43, 15, 73, 4, 15, 1, 0, 1, 1)
  691.                   ' see if win opened successfully
  692.                   IF w2 < 0 THEN
  693.                     ' code to handle failure of window to open
  694.                     CLS
  695.                     PRINT "w2 BlankWin error code: "; w2
  696.                     END
  697.                   END IF
  698.      
  699.                   ' display title and contents of input fields
  700.                   d = ShowWinText(2, 2, 15, ButtonsText(nam))
  701.                   d = ShowWinText(3, 2, 15, ButtonsText(addr))
  702.                   d = ShowWinText(4, 2, 15, ButtonsText(city))
  703.                   d = ShowWinText(5, 2, 15, ButtonsText(state))
  704.                   d = ShowWinText(6, 2, 15, ButtonsText(zip))
  705.                   d = ShowWinText(8, 2, 11, "CANNOT click on SHOW")
  706.                   d = ShowWinText(9, 2, 11, "while this window is open.")
  707.                   d = ShowTitle("INPUT FIELDS", 15, 1)
  708.  
  709.  
  710.             END SELECT
  711.         END SELECT
  712.  
  713.     CASE w2         ' child window
  714.         ' now determine what type of event occurred in the window w2
  715.         SELECT CASE action
  716.         CASE 1      ' close
  717.             xx = CloseWindow  ' close sub window (w2)
  718.            
  719.             ' now redisplay show and exit buttons
  720.             ' and leave focus in window containing the buttons
  721.             d = ActivateButton(sho, 0)
  722.             d = ActivateButton(xit, 0)
  723.  
  724.        
  725.         CASE 2      ' text
  726.             ' no scrollable text to select in this win
  727.             ' this case could be omitted
  728.        
  729.         CASE 3      ' button
  730.             ' no buttons in this win
  731.             ' this case could be omitted
  732.         END SELECT
  733.  
  734.     END SELECT
  735.  
  736. LOOP
  737.  
  738. LOCATE 25, 1
  739. CALL SetColor(15, 4)
  740. PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
  741. SLEEP
  742.  
  743. LOCATE 25, 1
  744. CALL SetColor(8, 15)
  745. PRINT STRING$(80, 178);
  746.  
  747.  
  748. END SUB
  749.  
  750. '
  751. ' open two windows with scrollable text and buttons
  752. '
  753. ' user clicks on a line in the scrollable text;
  754. ' a child window will be opened and the selected text line displayed
  755. ' in an input field.
  756. '
  757. ' only one child window for each original scrollable text window
  758. ' will be allowed.
  759. '
  760. ' clicking on a new line in scrollable text while child window is open
  761. ' will cause new line to be displayed in the child window's input field.
  762. '
  763. ' closing scrollable text window while a child window is open
  764. ' will first cause child window to be closed.
  765. '
  766. SUB demo5
  767.  
  768.  
  769. ' create a string array to hold scrollable text
  770. DIM Text(1 TO 30) AS STRING
  771. ' create some scrollable text
  772. ' entire array not filled, trailing null entries will not be displayed
  773. FOR i = 1 TO 25
  774.     Text(i) = "Window 1 - Line " + STR$(i)
  775. NEXT
  776.  
  777. ' open a window with scrollable text
  778. w1 = OpenScrollWindow(3, 3, 21, 25, 3, 15, 2, 15, Text(), 4, 2, 14, 20, 0, 1)
  779.  
  780. ERASE Text   ' to save space
  781.  
  782.  
  783. ' test to see if window was successfully opened
  784. IF w1 < 0 THEN
  785. '  some code to handle the error
  786.     CLS
  787.     PRINT "w1 OpenScrollWindow error: "; w1
  788.     END
  789. END IF
  790.  
  791.  
  792. ' put a vertical line in window and some text
  793. d = MakeHorizLine(15, 2)
  794. d = MakeHorizLine(3, 2)
  795. d = ShowWinText(2, 3, 14, "Double click text")
  796. ' no checking for error return codes was done for above calls
  797.  
  798.  
  799. ' make buttons.
  800. ' save handle numbers in variables.
  801. ' these will be used later to determine which button was clicked.
  802. xit1 = MakePushButton(16, 7, 6, "EXIT", 15, 4, 1)
  803.  
  804. ' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
  805. WinParms(CurWinPtr, 16) = xit1' put handle of exit button into data structure
  806. CALL ChangeButtonFocus(xit1, 0) ' reverse video the button to give it focus
  807.  
  808. ' put a title in window
  809. d = ShowTitle("First Window", 15, 4)
  810.  
  811. '----------------------------------------------------------
  812. ' re-define array for scrollable text (different size)
  813. REDIM Text(1 TO 20)  AS STRING
  814. FOR i = 1 TO 20
  815.     Text(i) = "Window 2 - Line " + STR$(i)
  816. NEXT
  817.  
  818. ' open a window with scrollable text
  819. w2 = OpenScrollWindow(5, 13, 23, 35, 9, 15, 2, 15, Text(), 4, 2, 14, 20, 0, 1)
  820.  
  821. ERASE Text    ' to save space
  822.  
  823. ' test to see if window was successfully opened
  824. IF w2 < 0 THEN
  825. '  some code to handle the error
  826.     CLS
  827.     PRINT "w2 OpenScrollWindow error: "; w2
  828.     END
  829. END IF
  830.  
  831.  
  832. ' put a vertical line in window and some text
  833. d = MakeHorizLine(15, 2)
  834. d = MakeHorizLine(3, 2)
  835. d = ShowWinText(2, 3, 14, "Double click text")
  836. ' no checking for error return codes was done for above calls
  837.  
  838. ' make buttons.
  839. ' save handle numbers in variables.
  840. ' these will be used later to determine which button was clicked.
  841. xit2 = MakePushButton(16, 7, 6, "EXIT", 15, 4, 1)
  842.  
  843. ' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
  844. WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure
  845. CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus
  846.  
  847. ' put a title in window
  848. d = ShowTitle("Second Window", 15, 4)
  849.  
  850. '------------------------------------------------------------
  851. ' MAIN LOOP
  852. ' as long as any win is open
  853. ' wait for an event in any window, then process it
  854.  
  855. DO WHILE AnyWinOpen
  856.     ' wait for an event
  857.     ' win number (wn) and event code (action) returned
  858.     wn = WinEvent(action)
  859.  
  860.     ' test window number to see which window was current when event occurred
  861.     SELECT CASE wn
  862.  
  863.     CASE w1      ' first window
  864.         ' determine what type of event occurred in the window w1
  865.         SELECT CASE action
  866.         CASE 1      ' close
  867.             ' first see if a child window (w1s) is open.
  868.             ' if it is, IsWinOpen will return handle.
  869.             IF NOT IsWinOpen(w1s, Han) THEN
  870.                 xx = CloseWindow   ' sub win not open, close scrollable win
  871.             ELSE        ' sub win is open
  872.                 zz = CurWinPtr  ' save handle of current scrollable win
  873.                 CALL NewFocusWindow(Han)  ' make sub win current
  874.                 xx = CloseWindow          ' close it
  875.                 CALL NewFocusWindow(zz)   ' make scrollable win current
  876.                 xx = CloseWindow          ' close it
  877.             END IF
  878.  
  879.         CASE 2      ' text
  880.             ' save pointer to selected text line
  881.             TextLine = WinParms(CurWinPtr, 15)
  882.             ' save index in SaveText array where text is saved
  883.             ArrayIndex = WinParms(CurWinPtr, 18)
  884.            
  885.             ' if no child win already open,
  886.             ' then open one and display selected text
  887.            
  888.             ' IsWinOpen returns handle of window number if it's open
  889.             IF NOT IsWinOpen(w1s, Han) THEN
  890.  
  891.                 ' open a blank window
  892.                 w1s = BlankWin(5, 43, 10, 73, 4, 15, 1, 0, 1, 1)
  893.                 ' see if win opened successfully
  894.                 IF w1s < 0 THEN
  895.                     ' code to handle failure of window to open
  896.                     END
  897.                 END IF
  898.     
  899.                 ' display title
  900.                 d = ShowTitle("TEXT SELECTED - Win 1", 15, 1)
  901.      
  902.                 ' show the text selected in the new window
  903.                 t$ = SaveText(ArrayIndex, TextLine)' clicked line to be displayed
  904.                 w1f = MakeInputField(2, 2, 25, t$, 0, 7)
  905.            
  906.             ' if child win is open, update data in it
  907.             ELSE
  908.                 ' use handle returned by IsWinOpen to make sub win current
  909.                 CALL NewFocusWindow(Han)
  910.                 ' show the text selected in the new window
  911.                 ' put text into input field
  912.                 ButtonsText(w1f) = SaveText(ArrayIndex, TextLine)
  913.                 ' redisplay the input field
  914.                 CALL ReShowInputField(w1f)
  915.             END IF
  916.            
  917.             ' give focus back to window with text
  918.             CALL NewFocusWindow(w1)
  919.        
  920.         CASE 3      ' button
  921.             ' take advantage of fact that there is only one possible button
  922.             ' (which is EXIT)
  923.            
  924.             ' first see if a child window (w1s) is open.
  925.             ' if it is, IsWinOpen will return handle.
  926.             IF NOT IsWinOpen(w1s, Han) THEN
  927.                 xx = CloseWindow   ' sub win not open, close scrollable win
  928.             ELSE        ' sub win is open
  929.                 zz = CurWinPtr  ' save handle of current scrollable win
  930.                 CALL NewFocusWindow(Han)  ' make sub win current
  931.                 xx = CloseWindow          ' close it
  932.                 CALL NewFocusWindow(zz)   ' make scrollable win current
  933.                 xx = CloseWindow          ' close it
  934.             END IF
  935.         END SELECT
  936.  
  937.     CASE w2  ' second window
  938.         ' determine what type of event occurred in the window w1
  939.         SELECT CASE action
  940.         CASE 1      ' close
  941.             ' first see if a child window (w2s) is open.
  942.             ' if it is, IsWinOpen will return handle.
  943.             IF NOT IsWinOpen(w2s, Han) THEN
  944.                 xx = CloseWindow   ' sub win not open, close scrollable win
  945.             ELSE        ' sub win is open
  946.                 zz = CurWinPtr  ' save handle of current scrollable win
  947.                 CALL NewFocusWindow(Han)  ' make sub win current
  948.                 xx = CloseWindow          ' close it
  949.                 CALL NewFocusWindow(zz)   ' make scrollable win current
  950.                 xx = CloseWindow          ' close it
  951.             END IF
  952.  
  953.         CASE 2      ' text
  954.             ' save pointer to selected text line
  955.             TextLine = WinParms(CurWinPtr, 15)
  956.             ' save index in SaveText array where text is saved
  957.             ArrayIndex = WinParms(CurWinPtr, 18)
  958.           
  959.             ' if no child win already open,
  960.             ' then open one and display selected text
  961.            
  962.             ' IsWinOpen returns handle of window number if it's open
  963.             IF NOT IsWinOpen(w2s, Han) THEN
  964.  
  965.                 ' open a blank window
  966.                 w2s = BlankWin(15, 43, 20, 73, 5, 15, 1, 0, 1, 1)
  967.                 ' see if win opened successfully
  968.                 IF w2s < 0 THEN
  969.                     ' code to handle failure of window to open
  970.                     END
  971.                 END IF
  972.    
  973.                 ' display title
  974.                 d = ShowTitle("TEXT SELECTED - Win 2", 15, 1)
  975.     
  976.                 ' show the text selected in the new window
  977.                 t$ = SaveText(ArrayIndex, TextLine)' clicked line to be displayed
  978.                 w2f = MakeInputField(2, 2, 25, t$, 0, 7)
  979.            
  980.             ' if child win is open, update data in it
  981.             ELSE
  982.                 ' use handle returned by IsWinOpen to make sub win current
  983.                 CALL NewFocusWindow(Han)
  984.                 ' show the text selected in the new window
  985.                 ' put text into input field
  986.                 ButtonsText(w2f) = SaveText(ArrayIndex, TextLine)
  987.                 ' redisplay the input field
  988.                 CALL ReShowInputField(w2f)
  989.             END IF
  990.            
  991.             ' give focus back to window with text
  992.             CALL NewFocusWindow(w2)
  993.        
  994.        
  995.         CASE 3      ' button
  996.             ' take advantage of fact that there is only one possible button
  997.             ' (which is EXIT)
  998.           
  999.             ' first see if a child window (w2s) is open.
  1000.             ' if it is, IsWinOpen will return handle.
  1001.             IF NOT IsWinOpen(w2s, Han) THEN
  1002.                 xx = CloseWindow   ' sub win not open, close scrollable win
  1003.             ELSE        ' sub win is open
  1004.                 zz = CurWinPtr  ' save handle of current scrollable win
  1005.                 CALL NewFocusWindow(Han)  ' make sub win current
  1006.                 xx = CloseWindow          ' close it
  1007.                 CALL NewFocusWindow(zz)   ' make scrollable win current
  1008.                 xx = CloseWindow          ' close it
  1009.             END IF
  1010.  
  1011.         END SELECT
  1012.    
  1013.     CASE w1s, w2s      ' child windows
  1014.         ' to simplify things, i'll handle both child windows
  1015.         ' with same code. to further simplify, i'll only allow a close event.
  1016.         SELECT CASE action
  1017.         CASE 1  ' close
  1018.             xx = CloseWindow
  1019.         END SELECT
  1020.  
  1021.    
  1022.     END SELECT
  1023. LOOP
  1024.        
  1025. LOCATE 25, 1
  1026. CALL SetColor(15, 4)
  1027. PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
  1028. SLEEP
  1029.  
  1030. LOCATE 25, 1
  1031. CALL SetColor(8, 15)
  1032. PRINT STRING$(80, 178);
  1033.  
  1034. END SUB
  1035.  
  1036. '
  1037. '  show an example of using input field for password entry.
  1038. '  as text is entered, only * is displayed, but actual text is
  1039. '  stored in the ButtonsText data structure.
  1040. '
  1041. '  after entering password, click on button.
  1042. '  a modal window will be opened and text from ButtonsText data structure
  1043. '  displayed (your program would access this text to verify password).
  1044. '
  1045. '
  1046. SUB demo6
  1047.  
  1048. ' open a plain window (no scrollable text, close icon)
  1049. w1 = BlankWin(3, 3, 15, 43, 9, 15, 2, 0, 1, 1)
  1050.  
  1051. ' test to see if window was successfully opened
  1052. IF w1 < 0 THEN
  1053.     '  some code to handle the error
  1054.     CLS
  1055.     PRINT "w1 BlankWin error: "; w1
  1056.     END
  1057. END IF
  1058.  
  1059.  
  1060.  
  1061. ' display some text in the window
  1062. d = ShowWinText(2, 2, 14, "Select field; enter password;")
  1063. d = ShowWinText(3, 2, 14, "and click on SHOW button.")
  1064. d = ShowWinText(5, 2, 15, "Password:")
  1065. passwd = MakeInputField(5, 12, -8, "", 14, 1)
  1066. sho = MakePushButton(7, 5, 6, "SHOW", 15, 4, 1)
  1067. xit = MakePushButton(7, 22, 6, "EXIT", 15, 4, 1)
  1068.  
  1069.  
  1070.  
  1071. ' put a title in window
  1072. d = ShowTitle("Password Entry Window", 15, 4)
  1073.  
  1074. ' MAIN LOOP
  1075. ' as long as any win is open
  1076. ' wait for an event in any window, then process it
  1077.  
  1078. DO WHILE AnyWinOpen
  1079.     ' wait for an event
  1080.     ' win number (wn) and event code (action) returned
  1081.     wn = WinEvent(action)
  1082.  
  1083.     ' test window number to see which window was current when event occurred
  1084.     SELECT CASE wn
  1085.  
  1086.     CASE w1    ' main window
  1087.         ' now determine what type of event occurred in the window w1
  1088.         SELECT CASE action
  1089.         CASE 1      ' close
  1090.             xx = CloseWindow
  1091.  
  1092.         CASE 2  ' scrollable text
  1093.             ' there is no scrollable text, ignore this event
  1094.  
  1095.         CASE 3   ' button click
  1096.             SELECT CASE WinParms(CurWinPtr, 16)
  1097.             CASE xit
  1098.                 xx = CloseWindow
  1099.  
  1100.             CASE sho
  1101.                   ' first, deactivate clear the show & exit buttons to
  1102.                   ' this code should be placed before child window is opened
  1103.                   ' to insure that main window with buttons is active
  1104.                   ' (thus the FocusSw parm in DeactivateButton can be 0)
  1105.                   d = DeactivateButton(sho, 0)
  1106.                   d = DeactivateButton(xit, 0)
  1107.                 
  1108.                   ' open a modal child window and display the actual password
  1109.                   ' contents are in ButtonsText(passwd).
  1110.         
  1111.                   ' instead of opening a window,
  1112.                   ' you could use contents of ButtonsText(passwd)
  1113.                   ' to verify the password.
  1114.  
  1115.                   w2 = BlankWin(5, 33, 11, 60, 4, 15, 1, 0, 1, 2)
  1116.                   ' see if win opened successfully
  1117.                   IF w2 < 0 THEN
  1118.                     ' code to handle failure of window to open
  1119.                     CLS
  1120.                     PRINT "w2 BlankWin error code: "; w2
  1121.                     END
  1122.                   END IF
  1123.     
  1124.                   ' display title and contents of input fields
  1125.                   d = ShowWinText(2, 2, 14, "Password:")
  1126.                   d = ShowWinText(2, 12, 15, ButtonsText(passwd))
  1127.                   d = ShowWinText(5, 2, 14, "Close to continue.")
  1128.                   d = ShowTitle("PASSWORD", 15, 1)
  1129.             END SELECT   ' end of section for buttons
  1130.  
  1131.         END SELECT   ' end of section for main window
  1132.  
  1133.     CASE w2         ' child window with password
  1134.         ' now determine what type of event occurred in the window w2
  1135.         SELECT CASE action
  1136.         CASE 1      ' close
  1137.             xx = CloseWindow  ' close sub window (w2)
  1138.           
  1139.             ' now redisplay show and exit buttons
  1140.             ' and leave focus in window containing the buttons
  1141.             d = ActivateButton(sho, 0)
  1142.             d = ActivateButton(xit, 0)
  1143.  
  1144.       
  1145.         CASE 2      ' text
  1146.             ' no scrollable text to select in this win
  1147.             ' this case could be omitted
  1148.       
  1149.         CASE 3      ' button
  1150.             ' no buttons in this win
  1151.             ' this case could be omitted
  1152.         END SELECT
  1153.  
  1154.     END SELECT
  1155.  
  1156. LOOP
  1157.  
  1158. LOCATE 25, 1
  1159. CALL SetColor(15, 4)
  1160. PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
  1161. SLEEP
  1162.  
  1163. LOCATE 25, 1
  1164. CALL SetColor(8, 15)
  1165. PRINT STRING$(80, 178);
  1166.  
  1167.  
  1168. END SUB
  1169.  
  1170. ' =====================================================
  1171. '  returns type of video display
  1172. '
  1173. '  return values:
  1174. '       1:  black/white    (could be EGA/VGA with monochrome)
  1175. '       2:  CGA   (with color)
  1176. '       3:  EGA   (with color)
  1177. '       4:  VGA   (with color)
  1178. '       5:  MCGA  (with color)
  1179. '      99:  other
  1180. '
  1181. FUNCTION VidType
  1182.  
  1183. ' quick & dirty, check &h463
  1184. DEF SEG = 0
  1185. IF PEEK(&H463) = &HB4 THEN     ' see if monochrome
  1186.     VidType = 1
  1187.     EXIT FUNCTION
  1188. END IF
  1189. DEF SEG
  1190.  
  1191. ' first try int 10h, function 1Ah
  1192.  
  1193. InRegs.ax = &H1A00
  1194. CALL INTERRUPTX(&H10, InRegs, OutRegs)
  1195. IF (OutRegs.ax AND &HFF) = &H1A THEN    ' see if int 10h, funct 1Ah supported
  1196.     code = (OutRegs.bx AND &HFF)  ' get display code
  1197.     SELECT CASE code
  1198.     CASE 1      ' MDA
  1199.         VidType = 1
  1200.     CASE 2      ' CGA
  1201.         VidType = 2
  1202.     CASE 4      ' EGA color
  1203.         VidType = 3
  1204.     CASE 5      ' EGA b/w
  1205.         VidType = 1
  1206.     CASE 7      ' VGA b/w
  1207.         VidType = 1
  1208.     CASE 8      ' VGA color
  1209.         VidType = 4
  1210.     CASE 10     ' MCGA color
  1211.         VidType = 5
  1212.     CASE 11     ' MCGA b/w
  1213.         VidType = 1
  1214.     CASE ELSE
  1215.         VidType = 99    ' other
  1216.     END SELECT
  1217.     EXIT FUNCTION
  1218.  
  1219. ELSE
  1220.     ' now try int 10h, function 12h, sub-function 10h
  1221.     InRegs.ax = &H1200
  1222.     InRegs.bx = &H10
  1223.     CALL INTERRUPTX(&H10, InRegs, OutRegs)
  1224.     IF (OutRegs.bx AND &HFF00) = 1 THEN     ' see if monochrome
  1225.         VidType = 1
  1226.         EXIT FUNCTION
  1227.     END IF
  1228.  
  1229.     IF (OutRegs.bx AND &HFF) <> &H10 THEN   ' see if BL reg changed
  1230.         VidType = 3    ' EGA (not sure why it couldn't be VGA too!)
  1231.         EXIT FUNCTION
  1232.     END IF
  1233.  
  1234.     VidType = 99      ' other (probably CGA or MDA)
  1235.  
  1236. END IF
  1237.  
  1238. END FUNCTION
  1239.  
  1240.